home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d5 / willy.arc / EDWILLY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-06-11  |  14.2 KB  |  534 lines
  1. program willy;
  2.  
  3. type str = string[40];
  4.  
  5. var n,m,score,scrnum,balls,pcdlay,
  6.     oldx,oldy,worms,wx,wy,wc,
  7.     bcount,bonus,vx,vy,updown,
  8.     wxdir,wydir,jcount,lfrt,
  9.     color1,color2,color3       : integer;
  10.     ballx,bally,ballc,balld    : array[1..9] of integer;
  11.     chrset                     : array[1..1024] of byte;
  12.     screendata                 : array[1..9,1..40,1..24] of byte;
  13.     startxy                    : array[1..64,1..2] of byte;
  14.     screen                     : array[1..40,1..24] of byte;
  15.     dfile                      : file;
  16.     jflag,stop,win,lose        : boolean;
  17.     key                        : string[2];
  18.     tableofs,tableseg          : integer;
  19.  
  20. procedure setup;
  21.  
  22. var x,y,z:integer;
  23.     q:char;
  24.  
  25. begin
  26.   clrscr;
  27.   textcolor(white);
  28.   writeln('                    Willy the Worm Screen Editor --- Ver. 2.0');
  29.   writeln('                           by Alan Farmer, June 1985');
  30.   writeln;
  31.   writeln;
  32.   writeln('          This is a user-supported program.   Feel free to make copies');
  33.   writeln('          and pass them out, but  please  do not sell them.  Donations');
  34.   writeln('          of about $10 would be greatly appreciated.  Please send your');
  35.   writeln('          questions, comments, high scores, improved game screens, and');
  36.   writeln('          DONATIONS to:');
  37.   writeln;
  38.   writeln('                           Alan Farmer');
  39.   writeln('                           2743 McElroy Drive');
  40.   writeln('                           Charlottesville, Va  22903');
  41.   tableofs:=memw[$0000:$007c];
  42.   tableseg:=memw[$0000:$007e];
  43.   memw[$0000:$007c]:=ofs(chrset[1]);
  44.   memw[$0000:$007e]:=seg(chrset[1]);
  45.   assign(dfile,'WILLY.CHR');
  46.   reset(dfile);
  47.   blockread(dfile,chrset,8);
  48.   close(dfile);
  49.   assign(dfile,'WILLY.DAT');
  50.   reset(dfile);
  51.   blockread(dfile,screendata,60);
  52.   blockread(dfile,startxy,1);
  53.   close(dfile);
  54.   writeln;
  55.   writeln;
  56.   writeln;
  57.   write('                       Are you using a color monitor?  ');
  58.   repeat until keypressed;
  59.   read(kbd,q);
  60.   if upcase(q)='Y' then
  61.     begin
  62.       color1:=blue;
  63.       color2:=red;
  64.       color3:=yellow;
  65.     end
  66.   else
  67.     begin;
  68.       color1:=black;
  69.       color2:=darkgray;
  70.       color3:=lightgray;
  71.     end;
  72.   writeln; writeln;
  73.   write('                       Press Enter to begin ');
  74.   readln;
  75.   graphcolormode; palette(1); textcolor(3); graphbackground(color1);
  76.   if mem[$f000:$fffe]=$fd then pcdlay:=0 else pcdlay:=25;
  77. end;
  78.  
  79. procedure exit;
  80.  
  81. begin
  82.   memw[$0000:$007c]:=tableofs;
  83.   memw[$0000:$007e]:=tableseg;
  84.   textmode;
  85.   clrscr;
  86.   halt;
  87. end;
  88.  
  89. procedure winsound;
  90.  
  91. begin
  92.   gotoxy(13,10);
  93.   write('** Bonus ',bonus,' **');
  94.   for m:=1 to 5 do
  95.     begin
  96.       sound(2000);
  97.       delay(45);
  98.       nosound;
  99.       delay(30)
  100.     end;
  101. end;
  102.  
  103. procedure losesound;
  104.  
  105. begin
  106.   for m:=1 to 5 do
  107.     begin
  108.       sound(220);
  109.       nosound;
  110.       delay(m)
  111.     end;
  112.   for m:=12 downto 1 do
  113.     begin
  114.       sound(2000);
  115.       nosound;
  116.       delay(m div 2)
  117.     end;
  118.   for m:=1 to 20 do
  119.     begin
  120.       graphbackground(color2);
  121.       delay(pcdlay);
  122.       graphbackground(color3);
  123.       delay(pcdlay);
  124.     end;
  125.   graphbackground(color1);
  126. end;
  127.  
  128. procedure getscreen;
  129.  
  130. var box : boolean;
  131.  
  132. begin
  133.   graphcolormode; palette(1); textcolor(3); graphbackground(color1);
  134.   box:=false;
  135.   for n:=1 to 24 do
  136.     for m:=1 to 40 do
  137.       begin
  138.         screen[m,n]:=screendata[scrnum,m,n];
  139.         gotoxy(m,n);
  140.         write(char(screen[m,n]));
  141.         if (screen[m,n]=254) and (not box) then
  142.           begin
  143.             box:=true;
  144.             vx:=m;
  145.             vy:=n;
  146.           end;
  147.       end;
  148.   wx:=startxy[scrnum,1];
  149.   wy:=startxy[scrnum,2];
  150.   wc:=32;
  151.   gotoxy(3,25);
  152.   write('Score ',score:6,'  Bonus 1000  Worms ');
  153.   for n:=1 to worms-1 do write(chr(129))
  154. end;
  155.  
  156. procedure movewilly;
  157.  
  158. var z : integer;
  159.  
  160. begin
  161.   delay(pcdlay);
  162.   z:=memw[$40:28];
  163.   z:=z-2;
  164.   if z<30 then z:=60;
  165.   key:=concat(chr(mem[$40:z]),chr(mem[$40:z+1]));
  166.   case key[2] of
  167.     #1  :  exit;
  168.     'H' :  updown:=-1;
  169.     'P' :  updown:=1;
  170.     '9' :  if (jcount=0) and (screen[wx,wy+1]>=179) and
  171.              (screen[wx,wy+1]<=218) and (screen[wx,wy]<>131) then
  172.                begin
  173.                  updown:=0;
  174.                  jcount:=1;
  175.                  jflag:=true;
  176.                end;
  177.     'K' :  begin
  178.              updown:=0;
  179.              lfrt:=-1;
  180.            end;
  181.     'M' :  begin
  182.              updown:=0;
  183.              lfrt:=1;
  184.            end;
  185.     #$ff:  begin end;
  186.       else
  187.         begin
  188.           updown:=0;
  189.           lfrt:=0;
  190.         end
  191.     end;
  192.   memw[$40:z]:=255 shl 8;
  193.   oldx:=wx; oldy:=wy;
  194.   wxdir:=lfrt;
  195.   wydir:=0;
  196.   if jcount>0 then
  197.     begin
  198.       case jcount of
  199.         1 : wydir:=-1;
  200.         2 : wydir:=-1;
  201.         3 : wydir:=-1;
  202.         4 : wydir:=0;
  203.         5 : wydir:=1;
  204.         6 : wydir:=1;
  205.         7 : wydir:=1;
  206.       end;
  207.     end;
  208.   if (jcount=0) and (screen[wx,wy]<>131) and ((screen[wx,wy+1]<179)
  209.     or (screen[wx,wy+1]>218)) then
  210.       begin
  211.         wxdir:=0;
  212.         wydir:=1
  213.       end;
  214.   if (updown<>0) and (jcount=0) and (screen[wx,wy]=131) then
  215.     begin
  216.       lfrt:=0;
  217.       if updown<>0 then wxdir:=0;
  218.       wydir:=0;
  219.       if (updown=-1) and (wy>1) then
  220.         if screen[wx,wy-1]=131 then wydir:=-1;
  221.       if (updown=1) and (wy<24) then
  222.         if (screen[wx,wy+1]<179) or (screen[wx,wy+1]>218) then wydir:=1;
  223.     end;
  224.   if (jcount>0) and (screen[wx,wy]=131) then
  225.     begin
  226.       jcount:=0;
  227.       lfrt:=0;
  228.       wxdir:=0;
  229.       wydir:=0
  230.     end;
  231.   if (jcount=0) and (lfrt=-1) then
  232.     if wx-1<1 then lfrt:=0
  233.   else if (screen[wx-1,wy]>=179) and (screen[wx-1,wy]<=218) then lfrt:=0;
  234.   if (jcount=0) and (lfrt=1) then
  235.     if wx+1>40 then lfrt:=0
  236.   else if (screen[wx+1,wy]>=179) and (screen[wx+1,wy]<=218) then lfrt:=0;
  237.   if (wx+wxdir<1) or (wx+wxdir>40) then wxdir:=0;
  238.   if (wy+wydir<1) or (wy+wydir>24) then wydir:=0;
  239.   if jcount>0 then jcount:=(jcount+1) mod 8;
  240.   if (wxdir<>0) and (screen[wx,wy+1]=196) then
  241.     begin
  242.       screen[wx,wy+1]:=32;
  243.       gotoxy(wx,wy+1);
  244.       write(' ')
  245.     end;
  246.   if (screen[wx+wxdir,wy+wydir]<179) or (screen[wx+wxdir,wy+wydir]>218) then
  247.     begin
  248.       wx:=wx+wxdir;
  249.       wy:=wy+wydir
  250.     end
  251.   else wydir:=0;
  252.   if wydir<>0 then sound((25-wy)*100);
  253.   gotoxy(oldx,oldy); write(chr(wc));
  254.   wc:=screen[wx,wy]; gotoxy(wx,wy);
  255.   if lfrt=1 then write(chr(128)) else write(chr(129));
  256.   nosound;
  257.   if jcount=0 then jflag:=false;
  258.   if wc=132 then lose:=true;
  259.   if wc=133 then
  260.     begin
  261.       jcount:=1;
  262.       jflag:=true;
  263.     end;
  264.   if wc=134 then lfrt:=-lfrt;
  265.   if wc=136 then win:=true;
  266.   if wc=130 then
  267.     begin
  268.       wc:=32;
  269.       screen[wx,wy]:=wc;
  270.       score:=score+100;
  271.       gotoxy(9,25);
  272.       write(score:6);
  273.       sound(1200);
  274.       delay(10);
  275.       sound(1660);
  276.       delay(10);
  277.       nosound
  278.     end;
  279. end;
  280.  
  281. procedure moveballs;
  282.  
  283. var u,v : integer;
  284.  
  285. begin
  286.   if (random<0.1) and (balls<5) then
  287.     begin
  288.       balls:=balls+1;
  289.       ballx[balls]:=vx;
  290.       bally[balls]:=vy;
  291.       balld[balls]:=0;
  292.       ballc[balls]:=254
  293.     end;
  294.   m:=(6-balls)*12;
  295.   if m>0 then delay(m);
  296.   for u:=1 to balls do
  297.     begin
  298.       gotoxy(ballx[u],bally[u]);
  299.       write(char(ballc[u]));
  300.       if balld[u]=0 then
  301.         begin
  302.           v:=screen[ballx[u],bally[u]+1];
  303.           if ((v<179) or (v>218)) and (bally[u]<24) then bally[u]:=bally[u]+1
  304.           else if random<0.5 then balld[u]:=-1 else balld[u]:=1
  305.         end;
  306.      if (balld[u]=-1) and (ballx[u]=1) then balld[u]:=1;
  307.      if (balld[u]=1) and (ballx[u]=40) then balld[u]:=-1;
  308.      if balld[u]=-1 then
  309.         begin
  310.           v:=screen[ballx[u]-1,bally[u]];
  311.           if (v>=179) and (v<=218) then balld[u]:=1
  312.           else ballx[u]:=ballx[u]-1
  313.         end;
  314.       if balld[u]=1 then
  315.         begin
  316.           v:=screen[ballx[u]+1,bally[u]];
  317.           if (v>=179) and (v<=218) then balld[u]:=-1
  318.           else ballx[u]:=ballx[u]+1
  319.         end;
  320.       v:=screen[ballx[u],bally[u]+1];
  321.       if (v<179) or (v>218) then balld[u]:=0;
  322.       ballc[u]:=screen[ballx[u],bally[u]];
  323.       if ballc[u]=254 then
  324.         begin
  325.           ballx[u]:=vx;
  326.           bally[u]:=vy;
  327.           balld[u]:=0
  328.         end;
  329.       gotoxy(ballx[u],bally[u]);
  330.       write(char(135));
  331.       if (balld[u]=-1) and (ballx[u]=1) then balld[u]:=1;
  332.       if (balld[u]=1) and (ballx[u]=40) then balld[u]:=-1;
  333.     end
  334. end;
  335.  
  336. procedure collision;
  337.  
  338.   procedure jumped_one;
  339.  
  340.   begin
  341.     sound(1200);
  342.     score:=score+20;
  343.     gotoxy(9,25);
  344.     delay(8);
  345.     sound(1660);
  346.     delay(10);
  347.     nosound;
  348.     write(score:6);
  349.     jflag:=false
  350.   end;
  351.  
  352. begin
  353.   for m:=1 to balls do
  354.     begin
  355.       if jflag then case jcount of
  356.         2,7 : if (ballx[m]=wx) and (bally[m]=wy+1) then jumped_one;
  357.         3,6 : if (ballx[m]=wx) and (bally[m]=wy+2) then jumped_one;
  358.         4,5 : if (ballx[m]=wx) and (bally[m]=wy+3) then jumped_one;
  359.       end;
  360.       if (ballx[m]=wx) and (bally[m]=wy) then lose:=true;
  361.     end;
  362. end;
  363.  
  364. procedure playgame;
  365.  
  366. begin
  367.   worms:=1; score:=0;
  368.   balls:=0; bonus:=1000; bcount:=0;
  369.   lfrt:=0; updown:=0; jcount:=0;
  370.   lose:=false; win:=false;
  371.   getscreen;
  372.   repeat
  373.     bcount:=bcount+1;
  374.     if (bcount mod 15=0) then
  375.       begin
  376.         bonus:=bonus-10;
  377.         gotoxy(23,25);
  378.         write(bonus:4)
  379.       end;
  380.     if bonus=0 then lose:=true;
  381.     movewilly;
  382.     collision;
  383.     if not lose then moveballs;
  384.     if not lose then collision;
  385.   until win or lose;
  386.   if win then winsound;
  387.   if lose then losesound;
  388. end;
  389.  
  390. procedure edit;
  391.  
  392. var scan : byte;
  393.     f,t,x,y,z,p,d,q : integer;
  394.  
  395.   procedure show(words : str);
  396.  
  397.   begin
  398.     gotoxy(1,25);
  399.     clreol;
  400.     if words='' then write('Editing ',scrnum,'  Press A for help')
  401.       else write('Editing ',scrnum,'  ',words);
  402.   end;
  403.  
  404. begin
  405.   worms:=1;score:=0;scrnum:=1;
  406.   getscreen;
  407.   gotoxy(startxy[scrnum,1],startxy[scrnum,2]); write(chr(129));
  408.   show('');
  409.   x:=1;y:=1;
  410.   repeat
  411.     z:=memw[$40:28];
  412.     z:=z-2;
  413.     if z<30 then z:=60;
  414.     scan:=mem[$40:z+1];
  415.     gotoxy(x,y);
  416.     if (x=startxy[scrnum,1]) and (y=startxy[scrnum,2]) then write(chr(129))
  417.       else write(char(screendata[scrnum,x,y]));
  418.     case scan of
  419.       1  : exit;
  420.       72 : if y>1 then y:=y-1;
  421.       80 : if y<24 then y:=y+1;
  422.       75 : if x>1 then x:=x-1;
  423.       77 : if x<40 then x:=x+1;
  424.       30 : begin
  425.              gotoxy(1,6);
  426.              for m:=1 to 40 do write(chr(223));
  427.              for m:=1 to 40 do for n:=7 to 16 do
  428.                begin
  429.                  gotoxy(m,n);
  430.                  write(' ');
  431.                end;
  432.              gotoxy(1,17);
  433.              for m:=1 to 40 do write(chr(220));
  434.              gotoxy(1,7);
  435.              writeln(' E=',chr(196),' R=',chr(213),' T=',chr(209),' Y=',chr(184),
  436.                      ' U=',chr(133),' I=',chr(132),' O=',chr(131),' P=',chr(136));
  437.              writeln;
  438.              writeln(' D=',chr(205),' F=',chr(198),' G=',chr(216),' H=',chr(181),
  439.                      ' J=',chr(134),' K   L   ;');
  440.              writeln;
  441.              writeln(' C=',chr(179),' V=',chr(212),' B=',chr(207),' N=',chr(190),
  442.                      ' M=',chr(130),' ,=',chr(254),' .   /');
  443.              writeln;
  444.              writeln(' K=edit new screen  L=save all on disk');
  445.              writeln(' ;=copy screens     .=play this screen');
  446.              writeln(' /=change Willy''s starting position');
  447.              writeln('        Press Enter ',chr(17),chr(217),' to return');
  448.              readln;
  449.              for m:=1 to 40 do for n:=6 to 17 do
  450.                begin
  451.                  gotoxy(m,n);
  452.                  write(chr(screendata[scrnum,m,n]));
  453.                end;
  454.              gotoxy(startxy[scrnum,1],startxy[scrnum,1]); write(chr(129));
  455.            end;
  456.       32 : screendata[scrnum,x,y]:=205;
  457.       33 : screendata[scrnum,x,y]:=198;
  458.       34 : screendata[scrnum,x,y]:=216;
  459.       35 : screendata[scrnum,x,y]:=181;
  460.       19 : screendata[scrnum,x,y]:=213;
  461.       20 : screendata[scrnum,x,y]:=209;
  462.       21 : screendata[scrnum,x,y]:=184;
  463.       46 : screendata[scrnum,x,y]:=179;
  464.       47 : screendata[scrnum,x,y]:=212;
  465.       48 : screendata[scrnum,x,y]:=207;
  466.       49 : screendata[scrnum,x,y]:=190;
  467.       22 : screendata[scrnum,x,y]:=133;
  468.       23 : screendata[scrnum,x,y]:=132;
  469.       24 : screendata[scrnum,x,y]:=131;
  470.       25 : screendata[scrnum,x,y]:=136;
  471.       36 : screendata[scrnum,x,y]:=134;
  472.       18 : screendata[scrnum,x,y]:=196;
  473.       50 : screendata[scrnum,x,y]:=130;
  474.       51 : screendata[scrnum,x,y]:=254;
  475.       57 : screendata[scrnum,x,y]:=32;
  476.       39 : begin
  477.              repeat
  478.                show('Copy from ');
  479.                read(f);
  480.              until (f>0) and (f<9);
  481.              repeat
  482.                show('To ');
  483.                read(t);
  484.              until (t>0) and (t<9);
  485.              for d:=1 to 40 do for q:=1 to 24 do
  486.                screendata[t,d,q]:=screendata[f,d,q];
  487.              startxy[t,1]:=startxy[f,1];
  488.              startxy[t,2]:=startxy[f,2];
  489.              show('');
  490.            end;
  491.       38 : begin
  492.              show('Saving screens...');
  493.              assign(dfile,'WILLY.DAT');
  494.              rewrite(dfile);
  495.              blockwrite(dfile,screendata,60);
  496.              blockwrite(dfile,startxy,1);
  497.              close(dfile);
  498.              show('');
  499.            end;
  500.       37 : begin
  501.              repeat
  502.                show('Edit #');
  503.                read(scrnum);
  504.              until (scrnum>0) and (scrnum<9);
  505.              getscreen;
  506.              gotoxy(startxy[scrnum,1],startxy[scrnum,2]); write(chr(129));
  507.              show('');
  508.            end;
  509.       52 : begin
  510.              playgame;
  511.              getscreen;
  512.              gotoxy(startxy[scrnum,1],startxy[scrnum,2]); write(chr(129));
  513.              show('');
  514.            end;
  515.       53 : begin
  516.              gotoxy(startxy[scrnum,1],startxy[scrnum,2]);
  517.              write(chr(screendata[scrnum,startxy[scrnum,1],startxy[scrnum,2]]));
  518.              startxy[scrnum,1]:=x;
  519.              startxy[scrnum,2]:=y;
  520.              gotoxy(startxy[scrnum,1],startxy[scrnum,2]); write(chr(129));
  521.            end;
  522.       255: begin end;
  523.     end;
  524.     plot((x-1)*8,(y-1)*8,3);
  525.     mem[$40:z+1]:=255;
  526.   until false;
  527. end;
  528.  
  529. begin
  530.   randomize;
  531.   setup;
  532.   edit;
  533. end.
  534.